home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
newhead.zip
/
NEWHEAD.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1993-01-04
|
7KB
|
209 lines
PROGRAM Newhead (input,output);
{This program restores corrupted dBASE III file headers by
writing a new header on top of the old one, and supplying a new
record count based on user input. It is based on NEWHEAD.BAS by
Luis Castro.}
TYPE
{These type definitions map out the header structure. The
information is taken from the Advanced Programmer's Guide, page
295.}
field_desc = RECORD
fld_name : array [1..11] of char;
fld_type : char;
fld_addr : array [1..4] of byte;
fld_len : byte;
fld_dec : byte;
fld_res : array [1..14] of char;
END;
header = RECORD
hdr_start : array [1..4] of byte;
numrecs : array [1..4] of byte;
hdr_len : integer;
rec_len : integer;
hdr_res : array [1..20] of char;
fields : array [1..128] of field_desc;
END;
VAR
newfile, oldfile : file of header;
file1, file2 : string[12];
counter : integer;
num_recs : real;
fldtotal : integer;
i : integer;
j : integer;
new_struc : header;
old_struc : header;
file_found : boolean;
FUNCTION Power (x : real; y : integer) : real;
{This function does exponentiation. It makes up for the absence
of an exponentiation symbol like "^" or "**" in Pascal. It is
invoked by the command Power(x,y), which is the equivalent of
x^y.}
BEGIN
Power := exp(y*ln(x));
END;
BEGIN
Writeln;
Writeln ('*** ALL FILENAMES MUST INCLUDE EXTENSIONS ***');
Counter := 1;
REPEAT
{Get name of new structure file from user.}
REPEAT
Writeln;
Write ('Enter new structure FILENAME.EXT: ');
Readln (file1);
If Pos('.',file1) = 0 then
BEGIN
Writeln;
Writeln(Chr(7),'Filename Must Include Extension');
END;
UNTIL Pos('.',file1) <> 0;
{Open new structure file.}
Assign (newfile,file1);
{$I-} Reset (newfile) {$I+};
File_found := (IOresult = 0);
If NOT File_found then
BEGIN
Writeln;
Writeln(Chr(7),'File ',file1,' not found');
Counter := Counter + 1;
END;
UNTIL File_found OR (Counter = 4);
If File_found then
BEGIN
Counter := 1;
REPEAT
{Get name of corrupted file.}
REPEAT
Writeln;
Write ('Enter old FILENAME.EXT: ');
Readln (file2);
If Pos('.',file2) = 0 then
BEGIN
Writeln;
Writeln(Chr(7),'Filename Must Include Extension');
END;
If file2 = file1 then
BEGIN
Writeln;
Writeln(Chr(7),
'Old file and new file cannot be the same file');
file2 := 'file';
END;
UNTIL Pos('.',file2) <> 0;
{Open old structure file.}
Assign (oldfile,file2);
{$I-} Reset (oldfile) {$I+};
File_found := (IOresult = 0);
If NOT File_found then
BEGIN
Writeln;
Writeln(Chr(7),'File ',file2,' not found');
Counter := Counter + 1;
END;
UNTIL File_found OR (Counter = 4);
If File_found then
BEGIN
{Read files into memory.}
Read (newfile,new_struc);
Read (oldfile,old_struc);
Reset (oldfile);
{Convert number of records from four-byte integer
to real number.}
Num_recs := old_struc.numrecs[4]*power(2,24);
Num_recs := num_recs + old_struc.numrecs[3]*power(2,16);
Num_recs := num_recs + old_struc.numrecs[2]*power(2,8);
Num_recs := num_recs + old_struc.numrecs[1];
Writeln;
{Get desired number of records.}
Writeln ('Number of records: ',num_recs:0:0);
REPEAT
Write (' Change to: ');
Readln (num_recs);
If (num_recs < 0.0) OR (num_recs > 1E+9) then
BEGIN
Writeln;
Writeln(Chr(7),'Number of records out of range');
END;
UNTIL (num_recs >= 0.0) AND (num_recs <= 1E+9);
{Compute the number of fields from the total header length.
It equals the total length minus 34 bytes (the number of
bytes not devoted to field descriptor information),
divided by 32, the number of bytes per field descriptor.}
Fldtotal := (new_struc.hdr_len - 34) DIV 32;
{Move information from new structure into old structure.}
With old_struc DO
BEGIN
hdr_start := new_struc.hdr_start;
j := 4;
i := 24;
{The following lines of code convert the number of records
from a four-byte real number to a four-byte integer, by
dividing by 2^24, dividing the remainder by 2^16, dividing
this remainder by 2^8, until the quotient is 0. This allows
for the full number of records permitted by dBASE III.}
REPEAT
numrecs[j] := trunc(num_recs/power(2,i));
num_recs := num_recs - (int(num_recs/power(2,i))*power(2,i));
j := j - 1;
i := i - 8;
UNTIL i = 0;
numrecs[j] := trunc(num_recs);
hdr_len := new_struc.hdr_len;
rec_len := new_struc.rec_len;
hdr_res := new_struc.hdr_res;
{Move field descriptor arrays.}
For i:= 1 to (fldtotal) do
fields[i] := new_struc.fields[i];
END;
{Structure ends with carriage return, 0 string terminator,
and 20H deletion flag for first record (marking it as
.NOT. DELETED() ).}
With old_struc.fields[fldtotal+1] do
BEGIN
fld_name[1] := chr(13);
fld_name[2] := chr(0);
fld_name[3] := ' ';
END;
{Save restored file to disk.}
Write (oldfile,old_struc);
{Close files and END.}
Close (oldfile);
Close (newfile);
END;
END;
END.